perm filename M11B.F4[M11,LCS]5 blob
sn#418017 filedate 1979-02-10 generic text, type T, neo UTF8
00100 CGEN1 FUNCTION GENERATOR 1
00200 C *** MUSIC V ***
00300 SUBROUTINEGEN1
00400 COMMON I(1)/P/ P(1) /GENS/GENS(1)
00500 1 /LFUNC/LFUNC
00600 N1=1+(IFIX(P(4))-1)*LFUNC
00700 M1=7
00800 102 M=M1+1
00900 IF(P(M).LE.0)GO TO 103
01000 V1=P(M1-2)
01100 V2=(P(M1)-P(M1-2))/(P(M)-P(M1-1))
01200 MA=N1+IFIX(P(M1-1))
01300 MB=N1+IFIX(P(M))-1
01400 DO 101 J=MA,MB
01500 XJ=J-MA
01600 101 GENS(J)=V1+V2*XJ
01700 IF(IFIX(P(M)).EQ.(LFUNC-1))GO TO 103
01800 M1=M1+2
01900 GO TO 102
02000 103 GENS(MB+1)=P(M1)
02100 RETURN
02200 END
02300
02400 CGEN2 FUNCTION GENERATOR 2
02500 C *** MUSIC V ***
02600 SUBROUTINEGEN2
02700 COMMON I(1)/P/ P(1) /GENS/GENS(1)
02800 1 /LFUNC/LFUNC
02900 N1=1+(IFIX(P(4))-1)*LFUNC
03000 N2=N1+LFUNC-1
03100 DO 101 K1=N1,N2
03200 101 GENS(K1)=0.0
03300 FAC=6.283185/(FLOAT(LFUNC)-1.0)
03400 NMAX=I(1)
03500 N3=5+INT(ABS(P(NMAX)))-1
03600 IF(N3-5.LT.0)GO TO 104
03700 DO 103 J=5,N3
03800 FACK=FAC*FLOAT(J-4)
03900 DO 102 K=N1,N2
04000 102 GENS(K)=GENS(K)+SIN(FACK*FLOAT(K-N1))*P(J)
04100 103 CONTINUE
04200 104 N4=N3+1
04300 N5=I(1)-1
04400 IF(N5-N4.LT.0)GO TO 114
04500 DO 107 J1=N4,N5
04600 FACK=FAC*FLOAT(J1-N4)
04700 DO 106 K1=N1,N2
04800 106 GENS(K1)=GENS(K1)+COS(FACK*FLOAT(K1-N1))*P(J1)
04900 107 CONTINUE
05000 114 IF(P(NMAX).LE.0)GO TO 112
05100 FMAX=0.0
05200 DO 110 K2=N1,N2
05300 A=ABS(GENS(K2))
05400 110 IF(FMAX.LT.A)FMAX=A
05500 113 DO 111 K3=N1,N2
05600 111 GENS(K3)=GENS(K3)/FMAX
05700 RETURN
05800 112 FMAX=.99999
05900 GO TO 113
06000 END
06100
06200 CPARM CONTROL DATA SPECIFICATION FOR PASS 3
06300 C *** MUSIC V ***
06400 C
06500 C IP(1) = NUMBER OF OP CODES
06600 C IP(2) = BEGINNING SUBSCRIPT OF FIRST FUNCTION
06700 C IP(3) = STANDARD SAMPLING RATE
06800 C IP(4) = BEGINNING SUBSCRIPT OF INSTRUMENT DEFINITIONS
06900 C IP(5) = BEGINNING OF LOCATION TABLE FOR INSTRUMENT DEFINITIONS
07000 C IP(6) = LENGTH OF FUNCTIONS
07100 C IP(7) = BEGINNING OF NOTE CARD PARAMETERS
07200 C IP(8) = LENGTH OF NOTE CARD PARAMETER BLOCKS
07300 C IP(9) = NUMBER OF NOTE CARD PARAMETER BLOCKS
07400 C IP(10)= BEGINNING OF OUTPUT DATA BLOCK
07500 C IP(11)= SOUND ZERO (SILENCE VALUE)
07600 C IP(12)= SCALE FACTOR FOR NOTE CARD PARAMETERS
07700 C IP(13)= BEGINNING OF GENERATOR INPUT-OUTPUT BLOCKS
07800 C IP(14)= LENGTH OF GENERATOR INPUT-OUTPUT BLOCKS
07900 C IP(15)= SCALE FACTOR FOR FUNCTIONS
08000 C
08100 CS BLOCK DATA
08200 CS COMMON /PARM/IP(20)
08300 CS DATA IP/12,512,10000, 7100, 7000,512, 6000,35,27,4487,2048,
08400 CS 1 10 ,4487,512, "77777 ,5*0/
08500 CCC DATA IP/12,512,10000,14500,14400,512,13000,35,40,6657,2048,
08600 CCC 1 "1000000,6657,512,"377777777777,5*0/
08700 C*****BIG NUMB. IS IBM360'S BIGGEST. 1 65536,6657,512,Z7FFFFFFF/
08800 CS END
08900
09000
09100 CDSMOUT DEBUG SAMOUT 'C////'=CHANGES FOR PDP11 VERSION
09200 C *** MUSIC V ***
09300 C DEBUG SAMOUT
09400 SUBROUTINE SAMOUT(IDSK,N)
09500 COMMON I(1) /ROUT/ROUT(1) /FINOUT/PEAK,IPEAK,NBUF
09600 1 /CONV/CONV,INIOUT,JFLNM
09700 DIMENSION IDBUF(2048),JDBUF(512),NN(512),LDBUF(512)
09800 EQUIVALENCE (IDBUF,JDBUF),(LDBUF,IDBUF(513))
09900 C*** IDBUF WILL STORE PACKED SAMPLES. ****
10000 CSS INTEGER PEAK
10100 IF(INIOUT.EQ.0)GO TO 99
10200 C NOW OPEN PROPER OUTPUT FILE
10300 INIOUT=0
10400 IDSK=0
10500 IF(CONV.EQ.0)GO TO 199
10600 C CALL PUTFILE('11')
10700 CALL PUTEXT('TEST','SND')
10800 NN(1)="525252525252
10900 NN(2)=I(4)
11000 C I(4)=SRATE, I(8)=NCHNS(-1), FOR NEXT, 0=12 BIT, 1=18 BIT SMPLS.
11100 NN(3)="3000001
11200 NN(4)=I(8)+1
11300 NN(5)=64000
11400 DO 299 K=6,128
11500 299 NN(K)=0
11600 C CALL FASTOU(NN,128)
11700 CALL EXTOUT(NN,128)
11800 GO TO 99
11900 C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
12000 CX199X CALL OPEN(23,'TEST',0,'NEW',,,'UNF')
12100 199 CALL OFILE(23,'TEST')
12200 99 J=IDSK+1
12300 M1=1
12400 M2=0
12500 IDSK=IDSK+N
12600 C COUNTS SAMPLES TO DATE
12700 DO 1 K=J,IDSK
12800 S=ROUT(M1+M2)
12900 A=ABS(S)
13000 IF(A.GT.PEAK)PEAK=A
13100 IF(CONV.NE.0)S=S*64.
13200 C *64 TO CONVERT 12 BIT AMPL RANGE TO 16 BIT RANGE.
13300 IDBUF(K)=S
13400 1 M2=M2+1
13500 IF(IDSK.LT.NBUF)RETURN
13600 C NBUF=512,MONO =1024,STEREO
13700
13800 IF(CONV.EQ.0)GO TO 11
13900 M=1
14000 J=NBUF/2
14100 DO 44 K=1,J
14200
14300 NN(K)=(IDBUF(M)*"1000000).OR.(IDBUF(M+1).AND."777777)
14400 C PACKS 2 SMPLS PER WORD.
14500 CC NN(K)=IDBUF(M)*262144+IDBUF(M+1)
14600 C 16*262144=4194304
14700 44 M=M+2
14800
14900 CZ IF(MS(L).LT.0)MS(L)=4096+MS(L)
15000 CZ IDBUF(KL)=MS(3)+MS(2)*4096+MS(1)*16777216
15100 C PACKS 3 SMPLS TO A 36-BIT WORD. 4096=2**12, 16---=2**24.
15200 C MS(1) HAS LEFT HAND 12 BITS; MS(2), MIDDLE 12 BITS; MS(3), RIGHT 12.
15300 C NEGATIVE NUMBERS RUN FROM 4095(I.E. -1) TO 2049(I.E. -2048).
15400 C CALL FASTOU(NN,J)
15500 CALL EXTOUT(NN,J)
15600 GO TO 10
15700
15800 11 WRITE(23)JDBUF
15900 IF(NBUF.NE.512)WRITE(23),LDBUF
16000 C ABOVE FOR STEREO
16100 10 J=IDSK-NBUF
16200 IF(J.LT.1)GO TO 4
16300 DO 5 K=1,J
16400 5 IDBUF(K)=IDBUF(NBUF+K)
16500 4 IDSK=J
16600 RETURN
16700 END
16800
16900 CERRO1 GENERAL ERROR ROUTINE
17000 C *** MUSIC V ***
17100 SUBROUTINE ERROR(I)
17150 COMMON /NDEV/NDEV
17200 WRITE(NDEV,100),I
17300 100 FORMAT (' ERROR OF TYPE',I5/)
17400 RETURN
17500 END